VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsExtractCancel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private lngTotalRecords As Long
'Private dblMemberContribSum As Double
'Private dblAnnualSalaryNumberSum As Double
'Private dblAnnualSalarySum  As Double
'Private dblMemberExcessSum As Double

Public Function Extract() As Long
    
    Dim varRecords As Variant
    Dim strHeader As String
    Dim strFooter As String
        
    On Error GoTo Extract_Fix
        
    Extract = 0
    
     If objAdoConn.InitConnect(, "Keytax SQL", "KeyTax") Then
        If DataToExtract Then
            If DestinationFolderExists Then
                strHeader = CreateHeaderRecord
                If strHeader <> "" Then
                    varRecords = GetRecords
                    If varRecords(0) <> "" Then
                        strFooter = CreateFooterRecord
                        If strFooter <> "" Then
                            WriteToFile strHeader, varRecords, strFooter
                            Extract = lngTotalRecords
                        Else
                            Extract = ERROR_CREATING_FOOTER_RECORD
                        End If
                    Else
                        Extract = NO_DATA_TO_EXTRACT
                    End If
                Else
                    Extract = ERROR_CREATING_HEADER_RECORD
                End If
            Else
                Extract = NO_VALID_DESTINATION_FOLDER
            End If
        Else
            Extract = NO_DATA_TO_EXTRACT
        End If
    Else
        Extract = DATABASE_CONNECTION_FAILED
    End If

    Exit Function
Extract_Fix:
    HandleError Err.Number, Err.Description, "Extract"
    Extract = UNKNOWN_ERROR
End Function
Private Function DataToExtract() As Boolean

    Dim rsDirRequest As ADODB.Recordset
    Dim strSql As String
    
    On Error GoTo DataToExtract_Fix
        
    strSql = "Select max(req_seq_num) from DIR_DIRECTIVES_VW"
    strSql = strSql & " where CANCEL_PROCESS_STATUS = 'CA'"
    strSql = strSql & " and COM_ID <> 0"
    
    '*************************************************************************
    Set rsDirRequest = objAdoConn.OpenRecordset(strSql)
    If rsDirRequest.RecordCount > 0 Then
        If Not IsNull(rsDirRequest(0)) Then
            DataToExtract = True
        Else
            DataToExtract = False
        End If
    Else
        DataToExtract = False
    End If
    
    Exit Function
    
DataToExtract_Fix:
    HandleError Err.Number, Err.Description, "DataToExtract"
    DataToExtract = False
End Function

Private Function CreateHeaderRecord() As String
'This function creates a header record for the file to be sent to sars

    Dim strBuild As String
    Dim rsDate As ADODB.Recordset
    Dim rsSystemParameters As ADODB.Recordset
    Dim strSql As String
    Dim strTestData, strSysId As String
    
    
    On Error GoTo CreateHeaderRecord_Fix
    
    'get system paramenters (test_data and system id) from database
    strSql = "Select VAR_VALUE from DIR_PARAMETERS where CODE = 'ISP0901'"
    Set rsSystemParameters = objAdoConn.OpenRecordset(strSql)
    If rsSystemParameters.RecordCount > 0 Then
        If Not IsNull(rsSystemParameters!VAR_VALUE) Then
            strSysId = rsSystemParameters!VAR_VALUE
        Else
            MsgBox "System Parameter Error"
            CreateHeaderRecord = ""
        End If
    Else
        MsgBox "System Parameter Error"
        CreateHeaderRecord = ""
    End If
    strSql = "Select VAR_VALUE from DIR_PARAMETERS where CODE = 'TEST_DATA'"
    Set rsSystemParameters = objAdoConn.OpenRecordset(strSql)
    If rsSystemParameters.RecordCount > 0 Then
        If Not IsNull(rsSystemParameters!VAR_VALUE) Then
            strTestData = rsSystemParameters!VAR_VALUE
            If Len(strTestData) <> 1 Then
                MsgBox "System Parameter Error"
                CreateHeaderRecord = ""
            End If
        Else
            MsgBox "System Parameter Error"
            CreateHeaderRecord = ""
        End If
    Else
        MsgBox "System Parameter Error"
        CreateHeaderRecord = ""
    End If
            
    strBuild = "H"                                              'SEC-ID
    strBuild = strBuild & AlphaFormat("IRP3CRQ", 8, "L")        'INFO-TYPE, len:8, juxt: left, PADDED: BLANK
    strBuild = strBuild & AlphaFormat("", 8, "L")               'INFO-SUBTYPE, len:8, must contain blanks
    
    'strBuild = strBuild & "N"                                  'TEST-DATA, LEN:1, TEST DATA - 'Y' = NOT FOR PROD DB AND MUST BE REJECTED
    strBuild = strBuild & strTestData                           'TEST-DATA, LEN:1, TEST DATA - 'Y' = NOT FOR PROD DB AND MUST BE REJECTED
    
    strBuild = strBuild & "S"                                   'FILE-SERIES-CTL, LEN:1, MUST ALWAYS BE 'S'
    
'    strBuild = strBuild & AlphaFormat("ISP0901", 8, "L")       'EXT-SYS, LEN:8, JUXT: LEFT, PADDED: BLANK, (id of REQUESTOR - ISP0901)
    strBuild = strBuild & AlphaFormat(strSysId, 8, "L")         'EXT-SYS, LEN:8, JUXT: LEFT, PADDED: BLANK, (id of REQUESTOR - ISP0901)
    
    strBuild = strBuild & AlphaFormat("3", 8, "R")              'VER-NO, LEN:8, JUXT:RIGHT, (this no increases whenever there is a change to this file layout)
    strBuild = strBuild & AlphaFormat(GetNextFileName, 14, "L") 'OWN-FILE-ID, LEN:14, JUXT:LEFT, PADDED:BLANK (ALPHANUM - sender's no to uniquely id file
    Set rsDate = objAdoConn.OpenRecordset("Select GetDate()")
    strBuild = strBuild & DateFormat(rsDate(0), 14)              'GEN-TIME, LEN:14, (DATETIME: CCYYMMDD hhmmss)
'    strBuild = strBuild & "Y"                                   'ELECT-RESP, LEN:1, (Either this field or next must be 'Y', if both = 'N', then make
'    strBuild = strBuild & "N"                                   'PAPER-RESP, LEN:1,  if both = 'N', then make PAPER-RESP = 'Y'
        
    If Len(strBuild) <> 63 Then
        CreateHeaderRecord = ""
    Else
        CreateHeaderRecord = strBuild
    End If
    
    Exit Function
    
CreateHeaderRecord_Fix:
    HandleError Err.Number, Err.Description, "CreateHeaderRecord"
    CreateHeaderRecord = ""
End Function
Private Function GetNextFileName() As String

    Dim strLastFileName  As String
    Dim strNextFileName As String
    
    strLastFileName = objReg.AsciiFileName
    
     strNextFileName = "IRP3CRQ.C" & GetNextFileSeqNo

    objReg.AsciiFileName = strNextFileName
    GetNextFileName = strNextFileName

End Function
Private Function GetNextFileSeqNo() As String
'   This function gets the next out file seq number from the database

    Dim rsLastSeqNo As ADODB.Recordset
    Dim strSql As String
    Dim strFillString As String
    Dim strNextVal As String
    

    strSql = "Select LAST_VALUE from DIR_SEQUENCES where SEQ_NAME = 'DIR_IRP3CRQ_SEQ'"

    Set rsLastSeqNo = objAdoConn.OpenRecordset(strSql)
    If rsLastSeqNo.RecordCount > 0 Then
        If Not IsNull(rsLastSeqNo!LAST_VALUE) Then
            If rsLastSeqNo!LAST_VALUE = "999999" Then
                GetNextFileSeqNo = "000001"
            ElseIf rsLastSeqNo!LAST_VALUE = "" Then
                GetNextFileSeqNo = "000001"
            ElseIf rsLastSeqNo!LAST_VALUE = "0" Then 'barb: this should be added into formc
                GetNextFileSeqNo = "000001"
            Else
                strFillString = String(6, "0")
                strNextVal = CStr(rsLastSeqNo!LAST_VALUE + 1)
                GetNextFileSeqNo = Format(CStr(strNextVal), strFillString)
            End If
        Else
            GetNextFileSeqNo = "000001"
        End If
    Else
        GetNextFileSeqNo = "000001"
    End If
    
End Function

Private Function UpdateLastFileSeq(strLastUsedName As String) As Boolean
'   This function updates the out file seq no in the database

    Dim strLastDbName As String
    Dim strSql As String
    Dim lngRecordsAffected As Long

    strLastDbName = GetNextFileSeqNo
    If strLastUsedName = strLastDbName Then
      
        strSql = "Update DIR_SEQUENCES set LAST_VALUE = " & CDbl(strLastDbName) & " where SEQ_NAME = 'DIR_IRP3CRQ_SEQ'"
        
        lngRecordsAffected = objAdoConn.Executequery(strSql)
        If lngRecordsAffected = 1 Then
            UpdateLastFileSeq = True
        Else
            UpdateLastFileSeq = False
        End If
    Else
        UpdateLastFileSeq = False
    End If
    

End Function

Private Sub Class_Initialize()
    Set objAdoConn = Nothing
    Set objAdoConn = CreateObject("AdoDbserver.clsDbFunctions")
    Set objReg = New clsRegistry
End Sub

Private Sub Class_Terminate()
    Set objAdoConn = Nothing
    Set objReg = Nothing
End Sub
Private Function CreateFooterRecord() As String
'   This function creates the footer/trailer record in the
'   out\request file to sars

    Dim strBuild As String
    
    On Error GoTo CreatFooterRecord_Fix
    
    strBuild = "T"                        'SEC-ID, LEN:1, JUXT:RIGHT, PADDED:BLANK, ('T')
    strBuild = strBuild & NumericFormat(lngTotalRecords, 8, "R") 'REC-NO, LEN:8, JUXT:RIGHT AND LEFT (?), PADDED:BLANK, NUMERIC, (total no of records in file)
'    strBuild = strBuild & NumericFormat(dblMemberContribSum, 20, "R", "Cents") 'MEMBER-CONTRIB-SUM, LEN:20, JUXT:RIGHT, PADDED:BLANK, NUMERIC, (total of MEMBER-CONTRIB  fields in records)
'    strBuild = strBuild & NumericFormat(dblMemberExcessSum, 20, "R", "Cents") 'MEMBER-EXCESS-SUM, LEN:20, JUXT:RIGHT, PADDED:BLANK, NUMERIC, (total of MEMBER-EXCESS  fields in records)
'    strBuild = strBuild & NumericFormat(dblAnnualSalaryNumberSum, 8, "R") 'MEMBER-EXCESS-SUM, LEN:20, JUXT:RIGHT, PADDED:BLANK, NUMERIC, (total of ANNUAL-SALARY-NUMBER  fields in records)
'    strBuild = strBuild & NumericFormat(dblAnnualSalarySum, 16, "R") 'ANNUAL-SALARY-SUM, LEN:20, JUXT:RIGHT, PADDED:BLANK, NUMERIC, (total of ANNUAL-SALARY  fields in records)
        
    If Len(strBuild) <> 9 Then
        CreateFooterRecord = ""
    Else
        CreateFooterRecord = strBuild
    End If
    
    Exit Function
CreatFooterRecord_Fix:
    HandleError Err.Number, Err.Description, "CreateFooterRecord"
    CreateFooterRecord = ""
End Function
Private Function GetRecords() As Variant
'   This function extracts the data from the database, calculates the totals
'   formats each record and saves it to a dynamic array

    Dim rsSwoop As ADODB.Recordset
    Dim i As Long
    Dim strSql As String
    Dim arDataStrings()
'    Dim colSalaryDetails As Collection
    Dim arRowSet()
    Dim nMaxRowCount As Long
    
    On Error GoTo GetRecords_fix
    
    'Johann (20090218): If a max count was specificed, only select the max count records
    If Len(frmTest.txtMaxCount.Text) > 0 Then
        nMaxRowCount = CLng(frmTest.txtMaxCount.Text)
    End If
    
    strSql = "Select "
    
    'Johann (20090218): If a max count was specificed, only select the max count records
    If nMaxRowCount > 0 Then
        strSql = strSql & " TOP " & nMaxRowCount
    End If
    
    strSql = strSql & " REQ_SEQ_NUM, DIRECTIVE_NUMBER, INCOME_TAX_REFERENCE_NUMBER, CANCEL_REASON"
    strSql = strSql & " from DIR_DIRECTIVES_VW"
    strSql = strSql & " where CANCEL_PROCESS_STATUS = 'CA'"
    strSql = strSql & " and COM_ID <> 0"
        
    frmShanksOpt.Show
    frmShanksOpt.intCancel = 0
        
    Set rsSwoop = objAdoConn.OpenRecordset(strSql)
    
    'format data as per sars requirements
    If rsSwoop.RecordCount > 0 Then
        ReDim Preserve arDataStrings(rsSwoop.RecordCount + 1)
        rsSwoop.MoveFirst
        For i = 0 To rsSwoop.RecordCount - 1
            'extract single row into array
            arRowSet = rsSwoop.GetRows(1, adBookmarkCurrent)
            
'            'get salary details to pass to format function
'            Set colSalaryDetails = GetSalaryDetails(arRowSet(0, 0))

            'convert array of single row to sars record line string
            arDataStrings(i) = FormatRecordToString(arRowSet, i)
            
            'change record status in db to Extracted
            If Not UpdateReqRespStatus(arRowSet(0, 0), i) Then
              ReDim Preserve arDataStrings(1)
              arDataStrings(0) = ""
              GetRecords = arDataStrings
              Exit Function
            End If
            
            DoEvents
            frmShanksOpt.pgbPercent.Value = ((i + 1) / rsSwoop.RecordCount) * 100
            frmShanksOpt.Label1.Caption = "Extracting from database. Record:  " & (i + 1) & " of : " & rsSwoop.RecordCount
            frmShanksOpt.Refresh
        Next i
    Else
        'No data to extract
        ReDim arDataStrings(0)
        arDataStrings(0) = ""
        GetRecords = arDataStrings
        Unload frmShanksOpt
        Exit Function
    End If
    If lngTotalRecords = rsSwoop.RecordCount Then
        GetRecords = arDataStrings
    Else
        MsgBox "Error lngTotalRecords and extracted recordset count don't match"
    End If

'    Set colSalaryDetails = Nothing

Exit Function
GetRecords_fix:
    HandleError Err.Number, Err.Description, "GetRecords"
End Function
Private Function FormatRecordToString(varRecords As Variant, RecLineNo As Long) As Variant
'   Performs aggregate functions calls functions to format
'   data into strings as per sars
    
    Dim strBuild As String
    Dim i As Integer
    Dim j As Integer
        
    On Error GoTo FormatRecordToString_Fix
    
    'Calculate aggregates before converting into string
'    CalculateFooterAggregates varRecords(38, 0), varRecords(39, 0)
    lngTotalRecords = lngTotalRecords + 1
    
    strBuild = "R"
    'SEC-ID, LEN:1, 'R'
    
    strBuild = strBuild & AlphaFormat(varRecords(0, 0), 20, "L")
    'REQ-SEQ_NUM, LEN:20, JUXT:LEFT, PADDED:BLANK, ALPHANUM, (allocated by REQUESTOR - must be unique - done by db?)
        
     strBuild = strBuild & NumericFormat(varRecords(1, 0), 15, "R")
    'DIRID, LEN:15, JUXT:LEFT, PADDED:BLANK, ALPHANUM, (allocated by REQUESTOR - must be unique - done by db?)
           
    strBuild = strBuild & NumericFormat(varRecords(2, 0), 10, "R")
    'IT-REF-NO, LEN:10, NUMERIC, (if omitted, a reason must be provided
    
    strBuild = strBuild & AlphaFormat(varRecords(3, 0), 120, "L")
    'CANCEL-REASON   Directive Cancellation Reason   120 1   Alphanumeric
    
'******************************************************************************************
    'END OF RECORD
    
    'Johann(20090825): IBIR r4.300 changes
    'Changed length from 46 to 166
    If Len(strBuild) <> 166 Then
        HandleError 0, "Data record length is " & Len(strBuild) & " . Expected: 166 length.", "FormatRecordToString", strBuild
    End If
    
    FormatRecordToString = strBuild

    Exit Function
FormatRecordToString_Fix:
    HandleError Err.Number, Err.Description, "FormatRecordToString"
End Function

Private Function AlphaFormat(PreFormat As Variant, LenOfString As Long, Justification As String) As String

    On Error GoTo AlphaFormat_Fix

    'no quotes

    If Not IsNull(PreFormat) Then
        If PreFormat <> "" Then
            If UCase(Justification) = "L" Then
                AlphaFormat = Format(PreFormat, "!" & String(LenOfString, "@"))
            Else
                AlphaFormat = Format(PreFormat, String(LenOfString, "@"))
            End If
        Else
            AlphaFormat = Space(LenOfString)
        End If
    Else
        AlphaFormat = Space(LenOfString)
    End If
    
    Exit Function
AlphaFormat_Fix:
    HandleError Err.Number, Err.Description, "AlphaFormat"
End Function

Private Function NumericFormat(PreFormat As Variant, LenOfNumber As Long, Justification As String, Optional Rounding As String) As String

    Dim strFormatString As String
    Dim strValue As String
    Dim intPos As Integer
        
    On Error GoTo NumericFormat_Fix
        
        If IsNull(PreFormat) Then
            PreFormat = 0
        End If
    
    If UCase(Rounding) = "RAND" Then
         LenOfNumber = LenOfNumber - 4
        strFormatString = String(LenOfNumber, "0") & "#.##"
        strValue = CStr(Round(PreFormat, 0))
        NumericFormat = Format(strValue, strFormatString)
    ElseIf UCase(Rounding) = "CENTS" Then
        If PreFormat = 0 Then
            NumericFormat = String(LenOfNumber, "0")
        Else
'''''            'LenOfNumber = LenOfNumber - 4
'''''            'strValue = Round(PreFormat, 2)
'''''            strFormatString = String(LenOfNumber, "0") '& "0.00"
'''''            intPos = InStr(1, PreFormat, ".")
'''''            If intPos <> 0 Then
'''''                'strValue = Right(PreFormat, 2)
'''''                strValue = Mid(PreFormat, intPos + 1)
'''''                PreFormat = Left(PreFormat, intPos - 1)
'''''            Else
'''''                strValue = "00"
'''''            End If
'''''            PreFormat = PreFormat & strValue
'''''            NumericFormat = Format(CStr(PreFormat), strFormatString)
                strFormatString = String(LenOfNumber, "0")
                PreFormat = PreFormat * 100
                NumericFormat = Format(CStr(PreFormat), strFormatString)
        End If
    Else
        LenOfNumber = LenOfNumber '- 1
        strFormatString = String(LenOfNumber, "0") '& "#"
        'strValue = CStr(PreFormat)
        NumericFormat = Format(PreFormat, strFormatString)
    End If
    Exit Function
NumericFormat_Fix:
    HandleError Err.Number, Err.Description, "NumericFormat"
End Function

Private Function DateFormat(PreFormat As Variant, Optional LenOfDate As Long, Optional Justification As String) As String

    On Error GoTo DateFormat_Fix

    If Not IsNull(PreFormat) Then
        If PreFormat <> "" Then
            Select Case LenOfDate
                Case 4
                    'DateFormat = Format(PreFormat, "yyyy")
                    DateFormat = PreFormat
                Case 8
                    DateFormat = Format(PreFormat, "yyyymmdd")
                Case 14
                    DateFormat = Format(PreFormat, "YYYYMMDDhhmmss")
            End Select
        Else
            DateFormat = Space(LenOfDate)
        End If
    Else
        DateFormat = Space(LenOfDate)
    End If

    Exit Function
DateFormat_Fix:
    HandleError Err.Number, Err.Description, "DateFormat"
End Function




'Private Sub CalculateFooterAggregates(MemberContrib As Variant, MemberExcess As Variant)
'
'   On Error GoTo CalculateFooterAggregates_Fix
'
'   Dim i As Integer
'   Dim AnnualSalary As Long
'   Dim AnnualSalaryNumber As Long
'
'   'AnnualSalaryNumber = colSalaries.Count
'
'    If IsNull(MemberContrib) Then
'        MemberContrib = 0
'    End If
'    MemberContrib = CDbl(MemberContrib)
'
'   If IsNull(MemberExcess) Then
'        MemberExcess = 0
'    End If
'    MemberExcess = CDbl(MemberExcess)
'
'    'Calculating aggregates
'
'    dblMemberContribSum = dblMemberContribSum + MemberContrib
'    dblMemberExcessSum = dblMemberExcessSum + MemberExcess
'    For i = 1 To AnnualSalaryNumber
''        AnnualSalary = colSalaries(i)(2)
'        If IsNull(AnnualSalary) Then
'            AnnualSalary = 0
'        End If
'        AnnualSalary = CDbl(AnnualSalary)
'        dblAnnualSalarySum = dblAnnualSalarySum + AnnualSalary
'    Next i
'    dblAnnualSalaryNumberSum = dblAnnualSalaryNumberSum + AnnualSalaryNumber
'    lngTotalRecords = lngTotalRecords + 1
'
'    Exit Sub
'
'CalculateFooterAggregates_Fix:
'    HandleError Err.Number, Err.Description, "CalculateFooterAggregates"
'End Sub
Public Sub WriteToFile(strHeader As String, arRecords As Variant, strFooter As String)
'   This sub writes a specifies message to a specified file

    Dim intFreeFile As Long
    Dim i As Long
    Dim strFileName As String
    Dim strFilePathName As String
    
    On Error GoTo WriteFileFix
        
    strFileName = objReg.AsciiFileName
    
    strFilePathName = objReg.AsciiFileDest & strFileName
    
    'OPEN THE FILE
    intFreeFile = FreeFile
    Open strFilePathName For Append Access Write As #intFreeFile
    'WRITE TO FILE
    Print #intFreeFile, strHeader
    'barb:here - max 1000 data records per file
    'written to a file
    'max of 6 files per req type
    For i = 0 To lngTotalRecords - 1
        Print #intFreeFile, arRecords(i)
         DoEvents
        frmShanksOpt.pgbPercent.Value = ((i + 1) / lngTotalRecords) * 100
        frmShanksOpt.Label1.Caption = "Writing to Sars Request File. Record:  " & (i + 1) & " of : " & lngTotalRecords
        frmShanksOpt.Refresh
    Next i
    Print #intFreeFile, strFooter
    'CLOSE FILE
    Close #intFreeFile

    UpdateLastFileSeq Right(strFileName, 6)
    
    Unload frmShanksOpt
    
    Exit Sub

WriteFileFix:
    'IF THE SPECIFIED DIRECTORY DOESN'T EXIST CREATE IT, THEN OPEN/CREATE THE FILE
    If Err.Number = 76 Then
        MkDir objReg.AsciiFileDest
        Open strFilePathName For Append Access Write As #intFreeFile
        Print #intFreeFile, strHeader
        For i = 1 To lngTotalRecords
            Print #intFreeFile, arRecords(i)
        Next i
        Print #intFreeFile, strFooter
        Close #intFreeFile
    Else
        MsgBox "WriteFile: " & Err.Number & " - " & Err.Description, vbExclamation, "Directory Clean Up"
    End If
End Sub
Private Function UpdateReqRespStatus(Req_Seq_No, RecLineNo As Long) As Boolean

'   Updates scod status from Captured to Extracted and saves
'   extracted date

    Dim strSql As String
    Dim lngRecordsAffected As Long
    
    On Error GoTo UpdateReqRespStatus_Fix
    
    strSql = "Update DIR_RESPONSE"
    strSql = strSql & " set CANCEL_PROCESS_STATUS = 'EX'"
    strSql = strSql & " where REQ_SEQ_NUM = '" & Req_Seq_No & "'"
    lngRecordsAffected = objAdoConn.Executequery(strSql)
    If lngRecordsAffected <> 1 Then
        HandleError 0, "Update Dir_Response(CANCEL_PROCESS_STATUS) failed.", "GetRecords", "Update failed on REQ_SEQ_NUM: " & Req_Seq_No & "."
        UpdateReqRespStatus = False
    Else
        strSql = "Update DIR_REQUEST set"
        'strSql = strSql & " SCOD_PROCESS_STATUS = 'EX' ,"
        strSql = strSql & " PROCESS_STATUS_DATE = GETDATE() ,"
        strSql = strSql & " REQ_FILE_NAME = '" & objReg.AsciiFileName & "'"
        strSql = strSql & " where REQ_SEQ_NUM = '" & Req_Seq_No & "'"
        lngRecordsAffected = objAdoConn.Executequery(strSql)
        If lngRecordsAffected <> 1 Then
            HandleError 0, "Update Dir_Request(SCOD_PROCESS_STATUS) failed.", "GetRecords", "Update failed on REQ_SEQ_NUM: " & Req_Seq_No & "."
            UpdateReqRespStatus = False
        Else
            UpdateReqRespStatus = True
        End If
        UpdateReqRespStatus = True
    End If
Exit Function
UpdateReqRespStatus_Fix:
    HandleError Err.Number, Err.Description, "UpdateReqRespStatus"
    UpdateReqRespStatus = False
End Function

Private Function DestinationFolderExists() As Boolean

    Dim strCurrentRegFolder As String

    '\\LIB_NT_01\USERS\BJM0509\Temp

    On Error GoTo DestinationFolderExistsFix

    strCurrentRegFolder = objReg.AsciiFileDest

    If strCurrentRegFolder = "" Then
        frmDirType.Show vbModal
        If Not frmDirType.blnCancel Then
            strCurrentRegFolder = frmDirType.strDir
        Else
            DestinationFolderExists = False
            Exit Function
        End If
    End If
    
    If ValidDestinationFolder(strCurrentRegFolder) Then
            objReg.AsciiFileDest = strCurrentRegFolder
            DestinationFolderExists = True
        Else
            DestinationFolderExists = False
        End If
    Exit Function
    
DestinationFolderExistsFix:
    HandleError Err.Number, Err.Description, "DestinationFolderExists"
End Function
Private Function ValidDestinationFolder(ByVal strFolder As String) As Boolean

    On Error GoTo ValidDestinationFolderFix
    
    'CHECK IF DIR EXISTS, ELSE CREATE?
    If Dir(strFolder, vbDirectory) = "" Then
        frmDirType.strDir = strFolder
        frmDirType.Show vbModal
        If frmDirType.blnCancel Then
            ValidDestinationFolder = False
            Exit Function
        Else
            strFolder = frmDirType.strDir
        End If
    Else
        If Right(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
    End If
    
    ValidDestinationFolder = True
    
    Exit Function
    
ValidDestinationFolderFix:
    HandleError Err.Number, Err.Description, "ValidDestinationFolder"
End Function
Public Function GetErrorMessages(ErrorNumber As Long) As String

    On Error GoTo GetErrorMessagesFix

    If ErrorNumber > 0 Then
        GetErrorMessages = ErrorNumber & " records were extracted and written to file: " & objReg.AsciiFileDest & objReg.AsciiFileName
    Else
        Select Case ErrorNumber
            Case 0
                GetErrorMessages = "NO_DATA_TO_EXTRACT"
            Case -1
                GetErrorMessages = "DATABASE_CONNECTION_FAILED "
            Case -2
                GetErrorMessages = "ERROR_CREATING_HEADER_RECORD"
            Case -3
                GetErrorMessages = "ERROR_CREATING_FOOTER_RECORD"
            Case -4
                GetErrorMessages = "ERROR_READING_RECORDS"
            Case -5
                GetErrorMessages = "UNKNOWN_ERROR"
            Case -6
                GetErrorMessages = "NO_VALID_DESTINATION_FOLDER"
        End Select
    End If
    
    Exit Function
    
GetErrorMessagesFix:
    MsgBox Err.Number & " - " & Err.Description & " , GetErrorMessages"
End Function
'Private Function GetSalaryDetails(varReqSeqNo As Variant) As Collection
'
'    Dim strSql As String
'    Dim rsSalDet As ADODB.Recordset
'    Dim colSalDet As Collection
'    Dim i As Integer
'    Dim j As Integer
'    Dim arSalDet()
'
'    On Error GoTo GetSalaryDetailsFix
'    Set colSalDet = New Collection
'
'    strSql = "SELECT DAS.TAX_YEAR, DAS.ANNUAL_SALARY_AMT"
'    strSql = strSql & " FROM DIR_ANNUAL_SALARIES DAS, DIR_REQUEST R"
'    strSql = strSql & " WHERE R.REQ_SEQ_NUM = DAS.REQ_SEQ_NUM"
'    strSql = strSql & " AND R.REQ_SEQ_NUM = " & varReqSeqNo
'    Set rsSalDet = objAdoConn.OpenRecordset(strSql)
'    If rsSalDet.RecordCount > 0 Then
'        rsSalDet.MoveFirst
'        For j = 0 To rsSalDet.RecordCount - 1
'            ReDim Preserve arSalDet(rsSalDet.RecordCount + 1)
'            arSalDet(1) = rsSalDet(0)
'            arSalDet(2) = rsSalDet(1)
'            colSalDet.Add arSalDet, CStr(j)
'            rsSalDet.MoveNext
'        Next j
'
'    End If
'
'    Set GetSalaryDetails = colSalDet
'
'    Set colSalDet = Nothing
'
'    Exit Function
'
'GetSalaryDetailsFix:
'    HandleError Err.Number, Err.Description, "GetSalaryDetails"
'End Function
